C**************************************************************************
C>>NUMBER-CRUNSHER CLIPPER> > > > > >>OR<< < < < <RENASCENCE FOR FORTRAN<<*
C**************************************************************************
C       Advanced Interface: Clipper(Su'87) & Microsoft Fortran 4.x        * 
C        (See Ed Bell's Interface to Ratfor in NanNews 9/10 '88.)         * 
C-------------------------------------------------------------------------*
C                   (c) Jobst Hensiek,  January 1989                      * 
C Claustorwall 23 / D - 3380 Goslar 1 / WEST Germany / 011-495-321-4457   *
C                   CLIPPER(tm) of NANTUCKET CORP.                        *
C                MS FORTRAN 4.1 (tm) of MICROSOFT CORP.                   *
C**************************************************************************
C
C What you need: 
C         1. Clipper Su '87  
C         2. MS-Fortran 4.x (...)
C            (Install LLIBFORA to !!NO!! C-compatability, otherwise you 
C              will have to link LLIBCA as well!!)
C         3. File EXTOR.OBJ (Included in R. McConnell's C-Goodies, PD) 
C            (I put it in this ARC)       
C
C What you should keep in mind: 
C         1.) Include this file 'EX.F' at the top of your FORTRAN application  
C             ==> $INCLUDE:'EX.F'
C         2.) Declare the FORTRAN-SUB in your Clipper-file as EXTERNAL. 
C         3.) Your Fortran application should be a SUBROUTINE.
C         4.) SET FL=/c /AL /FPa /Olt /Gs /Zl <FILE.FOR> ; Compiler switches
C         5.) PLINK86 FI <CLIPPER.OBJ>,<FORTRAN.OBJ>,<EXTOR.OBJ> 
C                     SEARCH CLIPPER,LLIBFORA      
C         6.) Use $LARGE, or set the '/Gtxxxx'(CAREFULL) - Compiler Switch.                        
C              ($LARGE IS SAFE!)
C
C If you have new idea's:
C         1.) Post a msg to :76656,1606 (CompuServe)
C             But DON'T waste your money on the phone.
C             **** I live at least six hour's ahead of you (EASTERN TIME+6)!   
C
$LARGE
C Pass String to Fortran
C CLIPPER: x=CLPFOR("STRING")
C FORTRAN: CHARACTER*N A,PARC     * N String-Length, declare PARC and A 
C          A=PARC(ORDER [,INDEX)
       INTERFACE TO CHARACTER*(*) FUNCTION PARC 
     + [C, VARYING, ALIAS:'__parc'] (N) 
       INTEGER*2 N 
       END 
 
C Pass reserved String-LENGTH to Fortran
C CLIPPER: X=SPACE(40)
C          X="STRING"
C          Y=CLPFOR(@X)
C FORTRAN: INTEGER*2 N,PARCSZ           * N String-Length, declare PARCSZ, N 
C          N=PARCSZ(ORDER [,INDEX)
       INTERFACE TO INTEGER*2 FUNCTION PARCSZ 
     + [C, VARYING, ALIAS:'__parcsiz'] (N) 
       INTEGER*2 N 
       END 
                                        
C Pass String-LENGTH to Fortran
C CLIPPER: X="STRING"
C          Y=CLPFOR(X)
C FORTRAN: INTEGER*2 N,PARCLN          * N String-Length, declare PARCLN, N 
C          N=PARCLN(ORDER [,INDEX)
       INTERFACE TO INTEGER*2 FUNCTION PARCLN 
     + [C, VARYING, ALIAS:'__parclen'] (N) 
       INTEGER*2 N 
       END 
 
C Pass INTEGER to Fortran
C CLIPPER: X=69
C          Y=CLPFOR(X)
C FORTRAN: INTEGER*2 N,PARNI           * declare PARNI and N 
C          N=PARNI(ORDER [,INDEX)
       INTERFACE TO INTEGER*2 FUNCTION PARNI 
     + [C, VARYING, ALIAS:'__parni'] (N) 
       INTEGER*2 N 
       END 
 
C Pass LONG-INTEGER to Fortran
C CLIPPER: X=9696969
C          Y=CLPFOR(X)
C FORTRAN: INTEGER*4 N,PARNL           * declare PARNL and N 
C          N=PARNI(ORDER [,INDEX)
       INTERFACE TO INTEGER*4 FUNCTION PARNL 
     + [C, VARYING, ALIAS:'__parnl'] (N) 
       INTEGER*2 N 
       END 
 
C Pass DOUBLE to Fortran
C CLIPPER: X=96,96969
C          Y=CLPFOR(X)
C FORTRAN: REAL*8 X,PARND              * declare PARND and X 
C          X=PARND(ORDER [,INDEX)
       INTERFACE TO REAL*8 FUNCTION PARND 
     + [C, VARYING, ALIAS:'__parnd'] (N) 
       INTEGER*2 N 
       END 
 
C Pass LOGICAL to Fortran
C CLIPPER: X=.T.
C          Y=CLPFOR(X)
C FORTRAN: INTEGER*2 N,PARL             * declare PARL, N, L and INLOG 
C          LOGICAL*2 INLOG,L            * 
C          L=INLOG(PARL(ORDER [,INDEX))
       INTERFACE TO INTEGER*2 FUNCTION PARL 
     + [C, VARYING, ALIAS:'__parl'] (N) 
       INTEGER*2 N 
       END 
 
C Pass DATE-STRING to Fortran
C CLIPPER: X=CTOD("09\06\96")
C          Y=CLPFOR(X)
C FORTRAN: CHARACTER*8 A,PARDS          * declare PARDS and A 
C          N=PARDS(ORDER [,INDEX)
       INTERFACE TO CHARACTER*8 FUNCTION PARDS 
     + [C, VARYING, ALIAS:'__pards'] (N) 
       INTEGER*2 N 
       END 
 
C Get STRING-LENGTH in Fortran
C FORTRAN: CHARACTER*20 A               * declare A,N
C          INTEGER*2 N 
C          a='STRING'\\CHAR(0)
C          N=STRLEN(A)
       INTERFACE TO INTEGER*2 FUNCTION STRLEN 
     + [C,ALIAS:'_strlen'] (STR) 
       CHARACTER*(*) STR [REFERENCE]  
       END 
  
C--------------------------------------------------------------------
C  CLIPPER -<FUNCTION>- RETURN VALUES 
C  All data-types have to declared! (You know what I mean!?)
C
C  !DON't RETURN MORE THAN ONE VALUE OR STRING, OR KILL THE STACK!
C                                                    
C Push STRING to CLIPPER
C FORTRAN: A='Hello Ed'
C          CALL RETC(A)
C CLIPPER: Y=CLPFOR(X)
C          Y -< Hello Ed
       INTERFACE TO SUBROUTINE RETC 
     + [C, ALIAS:'__retc'] (STR) 
       CHARACTER*(*) STR [REFERENCE] 
       END 
 
C Push STRING to CLIPPER
C FORTRAN: A='Hello Ed'
C          CALL RCLEN('A')
C CLIPPER: Y=CLPFOR(X)
C          Y -< 8
       INTERFACE TO SUBROUTINE RCLEN 
     + [C, ALIAS:'__retclen'] (STR,N) 
       CHARACTER*(*) STR [REFERENCE]  
       INTEGER*2 N 
       END 
 
C Push INTEGER to CLIPPER
C FORTRAN: N=69
C          CALL RETNI(N)
C CLIPPER: Y=CLPFOR(X)
C          Y -< 69
       INTERFACE TO SUBROUTINE RETNI 
     + [C, ALIAS:'__retni'] (N) 
       INTEGER*2 N 
       END 
 
C Push LONG-INTEGER to CLIPPER
C FORTRAN: N=6969696969
C          CALL RETNL(N)
C CLIPPER: Y=CLPFOR(X)
C          Y -< 6969696969
       INTERFACE TO SUBROUTINE RETNL 
     + [C, ALIAS:'__retnl'] (N) 
       INTEGER*4 N 
       END 
 
C Push DOUBLE to CLIPPER
C FORTRAN: X=69,69696969
C          CALL RETND(N)
C CLIPPER: Y=CLPFOR(X)
C          Y -< 69,69696969
       INTERFACE TO SUBROUTINE RETND 
     + [C, ALIAS:'__retnd'] (N) 
       REAL*8 N 
       END 
 
C Push LOGICAL to CLIPPER
C FORTRAN: L=.TRUE.
C          CALL RETL(LOGIN(L))
C CLIPPER: Y=CLPFOR(X)
C          Y -<.T.
       INTERFACE TO SUBROUTINE RETL 
     + [C, ALIAS:'__retl'] (N) 
       INTEGER*2 N 
       END 

C Push DATE-STRING to CLIPPER
C FORTRAN: A='19690606'
C          CALL RETDS(A)
C CLIPPER: Y=CLPFOR(X)
C          Y < 06\06\69
       INTERFACE TO SUBROUTINE RETDS 
     + [C, ALIAS:'__retds'] (DSTR) 
       CHARACTER*8 DSTR [REFERENCE]  
       END 

C It cleans up the stack, i guess (?)
       INTERFACE TO SUBROUTINE RET 
     + [C, ALIAS:'__ret']  
       END 
 
C      ALLOCATE MEMORY. 
C      PARAMETER: REQUESTED SIZE IN BYTES. 
C      RETURNS FAR POINTER TO MEMORY OR NULL. 
 
       INTERFACE TO INTEGER*4 FUNCTION XMGRAB 
     + [C, ALIAS:'__exmgrab'] (N) 
       INTEGER*2 N 
       END 
 
       INTERFACE TO SUBROUTINE XMBACK 
     + [C, ALIAS:'__exmback'] (I, J) 
       INTEGER*4 I [REFERENCE] 
       INTEGER*2 J 
       END 
C ---------------------------------------------------------------------- 
C  Be sure, ALL PARAMETERS passed by REFERENCE from Clipper: <'@X'> !
C  McConnell's EXTOR-SYSTEM is very usefull for doing MATH with Clipper!
C  - This is my personal opinion.
C
C  !FEEL FREE TO RETURN MORE THAN ONE VALUE OR STRING, THE STACK LIKES IT!
C
C Push DOUBLE back to CLIPPER
C FORTRAN: CALL STRND(VALUE, ORDER [,INDEX)
       INTERFACE TO SUBROUTINE STRND 
     + [C, VARYING, ALIAS:'__stornd'] (X,N) 
       REAL*8 X   
       INTEGER*2 N 
       END 
 
C Push DOUBLE with DECIMAL's back to CLIPPER
C FORTRAN: CALL STRNDC(VALUE, DECIMAL, ORDER [,INDEX)
       INTERFACE TO SUBROUTINE STRNDC 
     + [C, VARYING, ALIAS:'__storndec'] (X,K,N) 
       REAL*8 X  
       INTEGER*2 K,N 
       END 
 
C Push LONG-INTEGER back to CLIPPER
C FORTRAN: CALL STRNL(VALUE, ORDER [,INDEX)
       INTERFACE TO SUBROUTINE STRNL 
     + [C, VARYING, ALIAS:'__stornl'] (K,N) 
       INTEGER*4 K  
       INTEGER*2 N  
       END 
 
C Push INTEGER back to CLIPPER
C FORTRAN: CALL STRNI(VALUE, ORDER [,INDEX)
       INTERFACE TO SUBROUTINE STRNI 
     + [C, VARYING, ALIAS:'__storni'] (K,N) 
       INTEGER*2 K,N
       END 
 
C Push STRING back to CLIPPER
C FORTRAN: CALL STRC('STRING', ORDER [,INDEX)
       INTERFACE TO SUBROUTINE STRC 
     + [C, VARYING, ALIAS:'__storc'] (STR,N) 
       CHARACTER*(*) STR [REFERENCE] 
       INTEGER*2 N 
       END 
 
C Push LOGICAL back to Clipper
C FORTRAN: CALL STRL(FLAG , ORDER [,INDEX)
       INTERFACE TO SUBROUTINE STRL 
     + [C, VARYING, ALIAS:'__storl'] (K,N) 
       INTEGER*2 K,N
       END 

C Push STRING-LEN back to CLIPPER
C FORTRAN: A='STRING'//CHAR(0)
C          CALL STRCLN(A, ORDER [,INDEX)
       INTERFACE TO SUBROUTINE STRCLN 
     + [C, VARYING, ALIAS:'__storclen'] (STR,K,N) 
       CHARACTER*(*) STR [REFERENCE] 
       INTEGER*2 K,N  
       END 
 
C Push DATE-STRING back to CLIPPER
C FORTRAN: CALL STRDS('DATE-STRING', ORDER [,INDEX)
       INTERFACE TO SUBROUTINE STRDS 
     + [C,VARYING,ALIAS:'__stords'] (DSTR,N) 
       CHARACTER*8 DSTR [REFERENCE] 
       INTEGER*2 N 
       END 

C Convert LOGICAL to INTEGER
C FORTRAN: CALL STORL(LOGIN(FLAG)) and pass it to Clipper
       INTEGER*2 FUNCTION LOGIN(L) 
       LOGICAL*2 L [VALUE]
       LOGIN=0
       IF(L)LOGIN=1
       RETURN
       END
C-------------------------------------------------------------------------
C A FUNCTION !!!MUST!!!ALWAYS!!! BE DECLARED IN THE CALLING SUBROUTINE!
C EXAMPLE: INTEGER*2 ALNGTH,N
C          N=ALNGTH(ORDER)
C

C Get Parameter Info. (Used in functions below)
       INTERFACE TO INTEGER*2 FUNCTION PINFO  
     + [C, ALIAS:'__parinfo'] (N) 
       INTEGER*2 N 
       END 
 
C Get Array-Parameter Info. (Used in functions below)
       INTERFACE TO INTEGER*2 FUNCTION PINFA 
     + [C, ALIAS: '__parinfa'] (K,N) 
       INTEGER*2 K,N 
       END 

C Convert INTEGER to LOGICAL
C FORTRAN: X=INLOG(PARL(ORDER))  
       LOGICAL*2 FUNCTION INLOG(N) 
       INTEGER*2 N [VALUE]
       INLOG=.FALSE.
       IF(N.EQ.1)INLOG=.TRUE.
       RETURN
       END

C Number of Parameters passed
C FORTRAN: N=PCOUNT()
       INTEGER*2 FUNCTION PCOUNT  
       INTEGER*2 PINFO 
       PCOUNT=PINFO(0) 
       RETURN 
       END  

C Size of array (INDEX - COUNT)
C FORTRAN: N=ALNGTH(ORDER)
       INTEGER*2 FUNCTION ALNGTH(N) 
       INTEGER*2 N [VALUE] 
       INTEGER*2 PINFA 
       ALNGTH=PINFA(N,0) 
       RETURN 
       END  
 
C Gives .TRUE. for a CHARACTER
C FORTRAN: L=ISCHAR(ORDER)
       LOGICAL*2 FUNCTION ISCHAR(N)  
       INTEGER*2 N [VALUE] 
       INTEGER*2 PINFO,INF  
       INF=PINFO(N) 
       ISCHAR=.FALSE. 
       IF ((INF.EQ.1).OR.(INF.EQ.33))ISCHAR=.TRUE. 
       RETURN 
       END 
 
C Gives .TRUE. for a NUMBER
       LOGICAL*2 FUNCTION ISNUM(N) 
       INTEGER*2 N [VALUE] 
       INTEGER*2 PINFO,INF 
       INF=PINFO(N) 
       ISNUM=.FALSE. 
       IF ((INF.EQ.2).OR.(INF.EQ.34))ISNUM=.TRUE. 
       RETURN 
       END 
 
C Gives .TRUE. for a LOGICAL
       LOGICAL*2 FUNCTION ISLOG(N) 
       INTEGER*2 N [VALUE] 
       INTEGER*2 PINFO,INF 
       INF=PINFO(N) 
       ISLOG=.FALSE. 
       IF ((INF.EQ.4).OR.(INF.EQ.36))ISLOG=.TRUE. 
       RETURN 
       END 
 
C Gives .TRUE. for a DATE-STRING
       LOGICAL*2 FUNCTION ISDATE(N) 
       INTEGER*2 N [VALUE] 
       INTEGER*2 PINFO,INF 
       INF=PINFO(N) 
       ISDATE=.FALSE. 
       IF ((INF.EQ.8).OR.(INF.EQ.40))ISDATE=.TRUE. 
       RETURN 
       END 

C Ceck for Memo (?)
       LOGICAL*2 FUNCTION ISMEMO(N) 
       INTEGER*2 N [VALUE] 
       INTEGER*2 PINFO,INF 
       INF=PINFO(N) 
       ISMEMO=.FALSE. 
       IF ((INF.EQ.65).OR.(INF.EQ.97))ISMEMO=.TRUE. 
       RETURN 
       END 
 
C Gives .TRUE. for a ARRAY  
       LOGICAL*2 FUNCTION ISARRY(N) 
       INTEGER*2 N [VALUE] 
       INTEGER*2 PINFO,INF 
       INF=PINFO(N) 
       ISARRY=.FALSE. 
       IF ((INF.EQ.512).OR.(INF.EQ.544))ISARRY=.TRUE. 
       RETURN 
       END 
 
C   Header structure. 
       SUBROUTINE DBF 
       COMMON /DBFBLK/SIG,YMD,LREC,DATA_OFF,REC_SIZE,PAD 
       CHARACTER*1  SIG 
       CHARACTER*3  YMD 
       INTEGER*4    LREC 
       INTEGER*2    DATA_OFF 
       INTEGER*2    REC_SIZE 
       CHARACTER*20 PAD(20) 
       RETURN 
       END 
